home *** CD-ROM | disk | FTP | other *** search
/ Graphics Plus / Graphics Plus.iso / general / hdf / unix / examples.lha / examples / sds / craypacking / test1.f < prev   
Encoding:
Text File  |  1991-10-23  |  3.5 KB  |  172 lines
  1. C    THIS PROGRAM READS FLOATING POINT DATA FILE SA10 AND SA11,
  2. C    BOTH WERE PRODUCED BY SARRAY.F ON SUN3. SA10 CONTAINS 10
  3. C    NUMBERS WHILE SA11 CONTAINS 12.
  4. C    
  5. C    THIS PROGRAM READS FROM THE INPUT FILES 8 BYTES EACH TIME
  6. C    AND STORE THE 8 BYTES INTO ARRAYS SA10(5) AND SA11(6) 
  7. C    RESPECTIVELY.
  8. C    IT THEN CALLS SCUP32() TO UPPACK THE SUN FLOATING POINT
  9. C    NUMBERS INTO CRAY FLOATING POINT NUMBERS AND STORES THOSE
  10. C    NUMBERS INTO CA10(10) AND CA11(11) RESPECTIVELY.
  11. C    CSPK32() IS THEN CALLED TO REPACK CA10(10) AND CA11(11)
  12. C    INTO SUN FLOATING POINT ARRAYS, SB10(5) AND SB11(6).
  13. C    COMPARE SB10(5) WITH SA10(5). THEY SHOULD BE THE SAME.
  14. C    WHILE COMPARE SB11(6) WITH SA11(6), THE 6TH ENTRIES 
  15. C    ARE DIFFERENT. IT IS BECAUSE THAT CA11(11) HAS ONLY 11
  16. C    ENTRIES. THE HIGH 4 BYTES OF SB11(6) CORRESPOND TO CA11(11)
  17. C    WHILE THE LOW 4 BYTES OF SB11(6) IS FILLED WITH 0'S.
  18. C
  19. C    THIS PROGRAM WAS WRITTEN TO TEST MODIFIED SCUP32.F AND CSPCK32.F
  20. C
  21. C    SHIMING XU, STG OF NCSA. OCT. 7, 1991
  22.     
  23.  
  24.  
  25.  
  26.     integer size,sa10(5), sa11(6), ca10(10),ca11(11),i
  27.     integer sb10(5),sb11(6)
  28.         REAL FA(10)
  29.     EQUIVALENCE (ca10,FA)
  30.  
  31.     OPEN(UNIT=20,FILE='sa10',FORM='UNFORMATTED',STATUS='OLD',
  32.      *         ACCESS='DIRECT', RECL=8,ERR=999)
  33.  
  34.     DO 130 i=1,5
  35.         read(20,rec=i) sa10(i)
  36. 130    CONTINUE
  37.  
  38.     DO 135 I=1,5
  39.        WRITE(*,150) SA10(I)
  40. 150     FORMAT(O24, F20.11)
  41. 135    CONTINUE
  42.  
  43.  
  44.     PRINT *
  45.  
  46.     CLOSE(20)
  47.  
  48.     CALL SCUP32(SA10,CA10,10,0)
  49. C    DO 160 I=1,10
  50. C       WRITE(30,rec=I) CA10(I)
  51. C 160    CONTINUE
  52.  
  53.     CALL CSPK32(CA10,sb10,10,0)
  54.     do 170 i=1,5
  55.         write(*,150) sb10(i)
  56.         if (sb10(i) .NE. sa10(i)) then 
  57.         write(*,*) 'NOT EQUAL',i
  58.             end if
  59. 170    continue
  60.  
  61.     write(*,*)
  62.     write(*,*) 'End of comparison of sa10 and sb10'
  63.     write(*,*)
  64.  
  65. C    Now work on odd number of input data
  66.  
  67.     
  68.     OPEN(UNIT=20,FILE='sa11',FORM='UNFORMATTED',STATUS='OLD',
  69.      *         ACCESS='DIRECT', RECL=8,ERR=999)
  70.     DO 230 i=1,6
  71.         read(20,rec=i) sa11(i)
  72. 230    CONTINUE
  73.  
  74.     DO 235 I=1,6
  75.        WRITE(*,250) SA11(I)
  76. 250     FORMAT(O24, F20.11)
  77. 235    CONTINUE
  78.  
  79.  
  80.     PRINT *
  81.  
  82.     CLOSE(20)
  83.  
  84.     CALL SCUP32(SA11,CA11,11,0)
  85. C    DO 260 I=1,11
  86. C       WRITE(30,rec=I) CA11(I)
  87. C 260    CONTINUE
  88.  
  89.     CALL CSPK32(CA11,sb11,11,0)
  90.     do 270 i=1,6
  91.         write(*,150) sb11(i)
  92.         if (sb11(i) .NE. sa11(i)) then 
  93.         write(*,*) 'NOT EQUAL',i
  94.             end if
  95. 270    continue
  96.  
  97. C    TEST ICHECK -- CHECKING FOR OVERFLOW AND UNDERFLOW
  98.  
  99.     OPEN(UNIT=20,FILE='sa10',FORM='UNFORMATTED',STATUS='OLD', 
  100.      *         ACCESS='DIRECT', RECL=8,ERR=999) 
  101.     DO 330 i=1,5 
  102.         read(20,rec=i) sa10(i)
  103. 330    CONTINUE
  104.  
  105.     DO 335 I=1,5
  106.        WRITE(*,350) SA10(I)
  107. 350     FORMAT(O24, F20.11)
  108. 335    CONTINUE
  109.  
  110.  
  111.     PRINT *
  112.  
  113.     CLOSE(20)
  114.  
  115.     CALL SCUP32(SA10,CA10,10,0)
  116. C    DO 160 I=1,10
  117. C       WRITE(30,rec=I) CA10(I)
  118. C 160    CONTINUE
  119.  
  120.     CALL CSPK32(CA10,sb10,10,1)
  121.     do 370 i=1,5
  122.         write(*,150) sb10(i)
  123.         if (sb10(i) .NE. sa10(i)) then 
  124.         write(*,*) 'NOT EQUAL',i
  125.             end if
  126. 370    continue
  127.  
  128.     write(*,*)
  129.     write(*,*) 'End of comparison of sa10 and sb10'
  130.     write(*,*)
  131.  
  132. C    Now work on odd number of input data
  133.  
  134.     
  135.     OPEN(UNIT=20,FILE='sa11',FORM='UNFORMATTED',STATUS='OLD',
  136.      *         ACCESS='DIRECT', RECL=8,ERR=999)
  137.     DO 430 i=1,6
  138.         read(20,rec=i) sa11(i)
  139. 430    CONTINUE
  140.     CLOSE(20)
  141.  
  142.     DO 435 I=1,6
  143.        WRITE(*,450) SA11(I)
  144. 450     FORMAT(O24, F20.11)
  145. 435    CONTINUE
  146.  
  147.  
  148.     PRINT *
  149.  
  150.     CLOSE(20)
  151.  
  152.     CALL SCUP32(SA11,CA11,11,0)
  153. C    DO 260 I=1,11
  154. C       WRITE(30,rec=I) CA11(I)
  155. C 260    CONTINUE
  156.  
  157.     CALL CSPK32(CA11,sb11,11,1)
  158.     do 470 i=1,6
  159.         write(*,150) sb11(i)
  160.         if (sb11(i) .NE. sa11(i)) then 
  161.         write(*,*) 'NOT EQUAL',i
  162.             end if
  163. 470    continue
  164.  
  165. 999    write(*,*) 'test --finished'
  166.  
  167.  
  168.     END
  169.  
  170.  
  171.     
  172.